home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / symboot.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-10-06  |  10.0 KB  |  382 lines
  1. /* ******************************************************************** */
  2. /*  symbols.c        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /*  General symbol hacking and global oblist                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, March 1990 (During compiler rationalisation)
  10.  */
  11.  
  12. #include <stdio.h>
  13. #include "funcalls.h"
  14. #include "defs.h"
  15. #include "structs.h"
  16. #include "global.h"
  17. #include "error.h"
  18. #include <string.h>
  19.  
  20. #include "symboot.h"
  21. #include "allocate.h"
  22. #include "copy.h"
  23.  
  24. #define strings_equal_p(a,b) (a[0] != b[0] ? FALSE : !strcmp(a,b))
  25.  
  26. LispObject ObList;
  27.  
  28.  
  29. typedef enum { LHere, LLeft, LRight, LFirst } LookupDirection;
  30.  
  31. LispObject get_symbol(LispObject* stackbase, char *name)
  32. {
  33.   static LispObject find_name_in_oblist(LispObject ,char *,LookupDirection *);
  34.   static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir);
  35.   
  36.   LookupDirection dir;
  37.   LispObject newloc,sym;
  38.  
  39.   newloc=find_name_in_oblist(ObList,name,&dir);
  40.   if (dir==LHere)
  41.     return newloc;
  42.   else
  43.     { /* NOT GC SAFE */
  44.       sym=allocate_symbol(stackbase,name);
  45.       add_sym_to_oblist(newloc,sym,dir);
  46.       return sym;
  47.     }
  48.   
  49. }
  50.  
  51. LispObject get_symbol_by_copying(LispObject *stackbase,char *name)
  52. {
  53.   static LispObject find_name_in_oblist(LispObject ,char *,LookupDirection *);
  54.   static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir);
  55.  
  56.   LispObject newloc,sym;
  57.   LookupDirection dir;
  58.  
  59.   newloc=find_name_in_oblist(ObList,name,&dir);
  60.   if (dir==LHere)
  61.     return(newloc);
  62.   else
  63.     {
  64.       char *copy;
  65.  
  66. #ifdef CGC
  67.       copy = (char *) malloc(strlen(name)+1); /* Ugh */
  68. #else
  69.       copy = (char *) allocate_space(stackbase, strlen(name) + 1); /* ouch */
  70. #endif
  71.       strcpy(copy,name);
  72.       
  73.       ARG_0(stackbase)=newloc;
  74.       sym= (LispObject) allocate_symbol(stackbase+1, copy);
  75.       add_sym_to_oblist(ARG_0(stackbase),sym,dir);
  76.       return sym;
  77.     }
  78. }
  79. static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir)
  80. {
  81.   switch(dir)
  82.     {
  83.     case LLeft:
  84.       where->SYMBOL.left=sym;
  85.       break;
  86.  
  87.     case LRight:
  88.       where->SYMBOL.right=sym;
  89.       break;
  90.       
  91.     case LFirst:
  92.       ObList=sym;
  93.     }
  94. }
  95.  
  96.  
  97. static LispObject find_name_in_oblist(LispObject tree,char *str,LookupDirection *dir)
  98. {
  99.   LookupDirection mydir=LFirst;
  100.   LispObject prev=NULL;
  101.   int newhash=hash(str);
  102.   
  103.   while(TRUE)
  104.     {
  105.       if (tree==NULL)
  106.     {
  107.       *dir=mydir;
  108.       return prev;
  109.     }
  110.  
  111.       if (newhash==tree->SYMBOL.hash)
  112.     {
  113.       if (strings_equal_p(tree->SYMBOL.pname,str))
  114.         {    
  115.           *dir=LHere;
  116.           return tree;
  117.         }
  118.       else
  119.         {
  120.           prev=tree; mydir=LLeft;
  121.           tree=tree->SYMBOL.left;
  122.         }
  123.     }
  124.       else 
  125.     {
  126.       if (tree->SYMBOL.hash<newhash)
  127.         {
  128.           prev=tree; mydir=LLeft;
  129.           tree=tree->SYMBOL.left;
  130.         }
  131.       else
  132.         {
  133.           prev=tree; mydir=LRight;
  134.           tree=tree->SYMBOL.right;
  135.         }
  136.     }
  137.     }
  138. }    
  139.  
  140. int reserved_symbol_p(LispObject sym)
  141. {
  142.   return((sym == sym_dynamic ||
  143.       sym == sym_dynamic_let ||
  144.       sym == sym_dynamic_setq ||
  145.       sym == sym_dynamic_set ||
  146. /*
  147.       sym == sym_defclass ||
  148.       sym == sym_defcondition ||
  149. */
  150.       sym == sym_defconstant ||
  151. /*
  152.       sym == sym_defgeneric ||
  153. */
  154.       sym == sym_deflocal ||
  155.       sym == sym_defmacro ||
  156. /*
  157.       sym == sym_defmethod ||
  158.       sym == sym_defstruct ||
  159. */
  160.       sym == sym_defun || 
  161.       sym == sym_defvar ||
  162.       sym == sym_if ||
  163.       sym == sym_lambda ||
  164.       sym == sym_letcc ||
  165.           sym == sym_with_handler ||
  166.       sym == nil || 
  167.       sym == sym_quote ||
  168.       sym == lisptrue ||
  169.       sym == sym_setq));
  170. }
  171.  
  172. /* Useful symbols to have... */
  173.  
  174. LispObject sym_nil;
  175.  
  176. LispObject sym_define;
  177. LispObject sym_function,sym_macro,sym_constant;
  178.  
  179. LispObject sym_defclass,sym_defcondition,sym_defconstant,sym_defgeneric,
  180.            sym_deflocal,sym_defmacro,sym_defmethod,sym_defstruct,sym_defun;
  181.  
  182. LispObject sym_defmodule,sym_load_module,sym_start_module,sym_enter_module;
  183.  
  184. LispObject sym_root;
  185.  
  186. LispObject sym_loaded_modules;
  187.  
  188. LispObject sym_lambda,sym_macro_lambda,sym_setq,sym_if,sym_progn;
  189. LispObject sym_import,sym_expose,sym_expose_except,sym_rename,sym_export;
  190. LispObject sym_root;
  191. LispObject sym_letcc,sym_unwind_protect;
  192.  
  193. LispObject sym_methods;
  194.  
  195. LispObject sym_defvar,sym_dynamic_setq,
  196.            sym_dynamic_set,sym_dynamic,sym_dynamic_let;
  197.  
  198. LispObject sym_with_handler;
  199.  
  200. LispObject sym_rest;
  201.  
  202. LispObject sym_cons;
  203.  
  204. /* defstruct symbols... */
  205.  
  206. LispObject sym_initarg,sym_initargs,sym_initform,sym_reader,sym_writer,
  207.            sym_accessor,sym_class,sym_mutable;
  208.  
  209. LispObject sym_constructor,sym_metaclass,sym_metaclass_initargs;
  210.  
  211. LispObject sym_position;
  212.  
  213. LispObject sym_message,sym_error_value;
  214.  
  215. LispObject sym_anonymous_class;
  216.  
  217. LispObject sym_name,sym_superclass,sym_slot_descriptions;
  218.  
  219. LispObject sym_exit;
  220.  
  221. LispObject sym_evalcm;
  222.  
  223. LispObject sym_tagbody;
  224.  
  225. void initialise_symbols(LispObject *stacktop)
  226. {
  227.   /* Garbage proofed by virtue of being on the object list */
  228.   /* Better do gensyms differently... */
  229.   add_root(&ObList);
  230.   
  231.  
  232.   sym_nil = get_symbol(stacktop,"nil");
  233.   add_root(&sym_nil);
  234.   sym_define   = get_symbol(stacktop,"define");
  235.   add_root(&sym_define);
  236.   sym_function = get_symbol(stacktop,"function");
  237.   add_root(&sym_function);
  238.   sym_macro    = get_symbol(stacktop,"macro");
  239.   add_root(&sym_macro);
  240.   sym_constant = get_symbol(stacktop,"constant");
  241.   add_root(&sym_constant);
  242.   
  243.   sym_defclass     = get_symbol(stacktop,"defclass");
  244.   add_root(&sym_defclass);
  245.   sym_defcondition = get_symbol(stacktop,"defcondition");
  246.   add_root(&sym_defcondition);
  247.   sym_defconstant  = get_symbol(stacktop,"defconstant");
  248.   add_root(&sym_defconstant);
  249.   sym_defgeneric   = get_symbol(stacktop,"defgeneric");
  250.   add_root(&sym_defgeneric);
  251.   sym_deflocal     = get_symbol(stacktop,"deflocal");
  252.   add_root(&sym_deflocal);
  253.   sym_defmacro     = get_symbol(stacktop,"defmacro");
  254.   add_root(&sym_defmacro);
  255.   sym_defmethod    = get_symbol(stacktop,"defmethod");
  256.   add_root(&sym_defmethod);
  257.   sym_defstruct    = get_symbol(stacktop,"defstruct");
  258.   add_root(&sym_defstruct);
  259.   sym_defun        = get_symbol(stacktop,"defun");
  260.   add_root(&sym_defun);
  261.   
  262.   sym_defmodule  = get_symbol(stacktop,"defmodule");
  263.   add_root(&sym_defmodule);
  264.   sym_load_module = get_symbol(stacktop,"load-module");
  265.   add_root(&sym_load_module);
  266.   sym_start_module = get_symbol(stacktop,"start-module");
  267.   add_root(&sym_start_module);
  268.   sym_enter_module = get_symbol(stacktop,"enter-module");
  269.   add_root(&sym_enter_module);
  270.   sym_loaded_modules = get_symbol(stacktop,"loaded-modules");
  271.   add_root(&sym_loaded_modules);
  272.   
  273.   sym_root = get_symbol(stacktop,"root");
  274.   add_root(&sym_root);
  275.   
  276.   sym_lambda  = get_symbol(stacktop,"lambda");
  277.   add_root(&sym_lambda);
  278.   sym_macro_lambda = get_symbol(stacktop,"macro-lambda");
  279.   add_root(&sym_macro);
  280.   sym_setq    = get_symbol(stacktop,"setq");
  281.   add_root(&sym_setq);
  282.   sym_if      = get_symbol(stacktop,"if");
  283.   add_root(&sym_if);
  284.   sym_progn   = get_symbol(stacktop,"progn");
  285.   add_root(&sym_progn);
  286.   sym_quote   = get_symbol(stacktop,"quote");
  287.   add_root(&sym_quote);
  288.   
  289.   sym_import = get_symbol(stacktop,"import");
  290.   add_root(&sym_import);
  291.   sym_expose = get_symbol(stacktop,"expose");
  292.   add_root(&sym_expose);
  293.   sym_expose_except = get_symbol(stacktop,"expose-except");
  294.   add_root(&sym_expose_except);
  295.   sym_rename = get_symbol(stacktop,"rename");
  296.   add_root(&sym_rename);
  297.   
  298.   sym_export = get_symbol(stacktop,"export");
  299.   add_root(&sym_export);
  300.   
  301.   sym_root = get_symbol(stacktop,"root");
  302.   add_root(&sym_root);
  303.   
  304.   sym_letcc          = get_symbol(stacktop,"let/cc");
  305.   add_root(&sym_letcc);
  306.   sym_unwind_protect = get_symbol(stacktop,"unwind-protect");
  307.   add_root(&sym_unwind_protect);
  308.   
  309.   sym_with_handler   = get_symbol(stacktop,"with-handler");
  310.   add_root(&sym_with_handler);
  311.   
  312.   sym_methods = get_symbol(stacktop,"methods");
  313.   add_root(&sym_methods);
  314.   
  315.   sym_defvar       = get_symbol(stacktop,"defvar");
  316.   add_root(&sym_defvar);
  317.   sym_dynamic_setq = get_symbol(stacktop,"dynamic-setq");
  318.   add_root(&sym_dynamic_setq);
  319.   sym_dynamic_set  = get_symbol(stacktop,"dynamic-set");
  320.   add_root(&sym_dynamic_set);
  321.   sym_dynamic_let  = get_symbol(stacktop,"dynamic-let");
  322.   add_root(&sym_dynamic_let);
  323.   sym_dynamic      = get_symbol(stacktop,"dynamic");
  324.   add_root(&sym_dynamic_let);
  325.   
  326.   sym_rest = get_symbol(stacktop,"rest");
  327.   add_root(&sym_rest);
  328.   
  329.   sym_cons = get_symbol(stacktop,"cons");
  330.   add_root(&sym_cons);
  331.   
  332.   sym_initarg  = get_symbol(stacktop,"initarg");
  333.   add_root(&sym_initarg);
  334.   sym_initargs = get_symbol(stacktop,"initargs");
  335.   add_root(&sym_initargs);
  336.   sym_initform = get_symbol(stacktop,"initform");
  337.   add_root(&sym_initform);
  338.   sym_reader   = get_symbol(stacktop,"reader");
  339.   add_root(&sym_reader);
  340.   sym_writer   = get_symbol(stacktop,"writer");
  341.   add_root(&sym_writer);
  342.   sym_accessor = get_symbol(stacktop,"accessor");
  343.   add_root(&sym_accessor);
  344.   sym_class    = get_symbol(stacktop,"class");
  345.   add_root(&sym_class);
  346.   sym_mutable  = get_symbol(stacktop,"mutable");
  347.   add_root(&sym_mutable);
  348.   
  349.   sym_constructor = get_symbol(stacktop,"constructor");
  350.   add_root(&sym_constructor);
  351.   sym_metaclass   = get_symbol(stacktop,"metaclass");
  352.   add_root(&sym_metaclass);
  353.   sym_metaclass_initargs = get_symbol(stacktop,"metaclass-initargs");
  354.   add_root(&sym_metaclass_initargs);
  355.   
  356.   sym_position = get_symbol(stacktop,"position");
  357.   add_root(&sym_position);
  358.   sym_message = get_symbol(stacktop,"message");
  359.   add_root(&sym_message);
  360.   sym_error_value = get_symbol(stacktop,"error-value");
  361.   add_root(&sym_error_value);
  362.   
  363.   sym_anonymous_class = get_symbol(stacktop,"anonymous-class");
  364.   add_root(&sym_anonymous_class);
  365.   
  366.   sym_name = get_symbol(stacktop,"name");
  367.   add_root(&sym_name);
  368.   sym_superclass = get_symbol(stacktop,"superclass");
  369.   add_root(&sym_superclass);
  370.   sym_slot_descriptions = get_symbol(stacktop,"slot-descriptions");
  371.   add_root(&sym_slot_descriptions);
  372.   
  373.   sym_exit = get_symbol(stacktop,"exit");
  374.   add_root(&sym_exit);
  375.   
  376.   sym_evalcm = get_symbol(stacktop,"eval/cm");
  377.   add_root(&sym_evalcm);
  378.   
  379.   sym_tagbody = get_symbol(stacktop,"tagbody");
  380.   add_root(&sym_tagbody);
  381. }
  382.